home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / dtl / form.cod < prev    next >
Encoding:
Text File  |  1993-03-09  |  54.2 KB  |  1,793 lines
  1. // Module Name: FORM.COD FOR 1.5
  2. // Description: This module produces dBASE IV .FMT files
  3. //              with popups for VALID clause field validation and
  4. //              Context Sensitive Help for each field
  5. //
  6.  
  7. Format (.fmt) File Template with POPUP field validation
  8. -------------------------------------------------------
  9. Copyright (c) 1987, 1990, 1991, 1992 Borland International, Inc.
  10.  
  11.  
  12. This template will support POPUPs for VALID clause field validations and
  13. context sensitive help for each field.
  14.  
  15. Example: In "ACCEPT value when" under "Edit options" enter,
  16.         "POPUP" = "vendor->vendor_id ORDER vendor_id REQ SHADOW"
  17.         --------------------------------------------------------
  18.         this will activate a popup if the data entered is invalid for
  19.         that field and will also make the field REQUIRED.
  20.  
  21. Explanation of the POPUP string follows:
  22.  
  23. POPUP              Indicates that a popup will be used for this field.
  24. vendor->vendor_id  Indicates the .DBF to open and FIELD to use as validation.
  25. ORDER vendor_id    Indicates which INDEX TAG to SEEK in.
  26. REQ                Indicates the FIELD requires data (can't be empty).
  27.                    Leave REQ out if the field is NOT required.      OPTIONAL!
  28. SHADOW             Use shadowing effect on popups                   OPTIONAL!
  29. NOTE: The POPUP string must be entered with the quotes as in the example.
  30.  
  31. --------------------------------------------------------------------------------
  32.  
  33. Explanation of the Context Sensitive Help file follows:
  34.  
  35. If you want to create your own help file, here is the structure that is required.
  36.  
  37. Structure for Help Database (.dbf):
  38. <first 6 chars. of the format file name>_H.dbf
  39.  
  40. Field   Field Name  Type        Width  Dec   Tag
  41. -------------------------------------------------
  42.     1   FLD_NAME    Character     10         Yes  Field name to lookup on F1
  43.     2   FLD_HEADNG  Character     25          No  Heading to show user on window
  44.     3   FLD_HELP    Memo          10          No  Help text to show user
  45. -------------------------------------------------
  46.         Total                     46
  47. {
  48. include "form.def"    // Form selectors
  49. include "builtin.def" // Builtin functions
  50.  
  51.  if getenv("dtl_debug") then
  52.    debug(2)
  53.    breakpoint( pick_debug )
  54.  endif
  55.  
  56. //
  57. // Enum string constants for international translation
  58. //
  59.  // Enum's for ON KEY labels AND error strings in FORM.DEF
  60.  enum  TRUE  = 1,
  61.        FALSE = 0,
  62.        offset = 2,         // Offset for lmarg()
  63.        range_require  = 2, // Bit for range required set
  64.        valid_required = 4, //  "   "  edit     "      "
  65.        screen_width = 80,  // Screen width for now
  66.        err_ext = ".err"
  67.  ;
  68. //
  69.  
  70.  var  bnl_formname,     // Name of BNL file to newframe if argument() has value
  71.       create_error,     // Indicates if there were problems creating programs
  72.       arg_list;
  73.  
  74.  arg_list = argument()
  75.  if arg_list != "" then
  76.    bnl_formname = token( ",", arg_list, 1 )
  77.    if !newframe( bnl_formname ) then
  78.      return -1;
  79.    endif
  80.  endif
  81.  
  82.  if FRAME_CLASS != form then // We are not processing a form object
  83.    pause(wrong_class + any_key)
  84.    goto NoGen;
  85.  endif
  86.  
  87.  
  88. var  fmt_name,     // Format file name
  89.      crlf,         // line feed
  90.      carry_flg,    // Flag to test carry loop
  91.      carry_cnt,    // Count of the number of fields to carry
  92.      carry_len,    // Cumulative length of carry line until 75 characters
  93.      carry_lent,   // Total cumulative length of carry line
  94.      base_name,        // First 6 characters of the NAME selector
  95.      procedure_name,   // First 7 characters of the NAME selector
  96.      udf_filename,     // UDF file name grabbed from .scb file
  97.      lookup_cnt,
  98.      carry_first,  // Flag to test "," output for carry fields
  99.      color_flg,    // Flag to if color should stay on am line
  100.      line_cnt,     // Count for total lines processed (Mulitple page forms)
  101.      page_cnt,     // Count for total pages processed (Mulitple page forms)
  102.      temp,         // tempory work variable
  103.      cnt,          // Foreach loop variable
  104.      wnd_cnt,      // Window counter
  105.      wnd_names,    // Window names so I can clear them at the bottom of the file
  106.      default_drv,  // dBASE default drive
  107.      dB_status,    // dBASE status before entering designer
  108.      scrn_size,    // Screen size when generation starts
  109.      left_delimiter, // Delimiter to put around SAY
  110.      right_delimiter,// Delimiter to put around SAY
  111.      max_pop_row,  // Maximum row that a popup or shadow can start
  112.      display,      // Type of display screen we are on
  113.      is_popup,     // POPUP validation requested
  114.      is_help,      // HELP (context sensitive) requested
  115.      udf_file,     // UDF file has been created
  116.      hlp_name,     // HELP .dbf name
  117.      trow_positn,  // Temporary variable for row_positn
  118.      tcol_positn,  // Temporary variable for col_positn
  119.      at_pop,       // "POPUP" is in FLD_OK_COND
  120.      master_file,  // Name of master alias based on first field on form
  121.      workarea_dbfs,// DBF files opened on the surface , delimited
  122.      color;        // Color returned from getcolor function
  123.  
  124.  //-----------------------------------------------
  125.  // Assign default values to some of the variables
  126.  //-----------------------------------------------
  127.  carry_flg = carry_first = carry_cnt = carry_len = carry_lent =
  128.  wnd_cnt = line_cnt =  color_flg = cnt = 0
  129.  crlf = chr(10)
  130.  master_file = workarea_dbfs = temp = ""
  131.  page_cnt = 1
  132.  is_popup = is_help = udf_file = 0
  133.  left_delimiter = right_delimiter = "\""
  134.  procedure_name = lower( rtrim( substr( NAME, 1, 7 )))
  135.  base_name      = lower( rtrim( substr( NAME, 1, 6 )))
  136.  udf_filename = "U_" + base_name
  137.  
  138.  //--------------------------------------------------------
  139.  // Determine the size of the screen and the max row that a 
  140.  // help and fill popup can extend to.
  141.  //--------------------------------------------------------
  142.  screen_size()
  143.  dB_status = numset(_flgstatus)
  144.  scrn_size = (!db_status ? scrn_size + 3 : scrn_size)
  145.  max_pop_row = scrn_size - 3;
  146.  
  147.  //-------------------------------
  148.  // Create Format file
  149.  //-------------------------------
  150.  if !make_Fmt() then goto nogen
  151.  
  152.  header()                   // Print Header in the Format file
  153.  fmt_file_initialization()  // Format file initializtion code
  154.  fmt_file_body()            // @ SAY GET Processing
  155.  fmt_file_exit()            // Format file exit code
  156.  make_pop_code()            // Create the Procedure File for POPUP's if required
  157.  make_help_code()           // Make procedures for the help system
  158.  if is_popup || is_help then
  159.    make_general_procs();
  160.  endif
  161.  fileerase(fmt_name+".fmo")
  162.  nogen:
  163. return 0;
  164.  
  165.  
  166. //---------------------------------------
  167. // Template user defined functions follow
  168. //---------------------------------------
  169.  
  170. define fmt_file_initialization()
  171. //
  172. // Format file initialization code
  173. //
  174. }
  175.  
  176. *-- Format file initialization code --------------------------------------------
  177.  
  178. *-- Some of these PRIVATE variables are created based on CodeGen and may not 
  179. *-- be used by your particular .fmt file
  180. PRIVATE ll_talk, ll_cursor, lc_display, lc_status, ll_carry, lc_proc
  181.  
  182. IF SET("TALK") = "ON"
  183.   SET TALK OFF
  184.   ll_talk = .T.
  185. ELSE
  186.   ll_talk = .F.
  187. ENDIF
  188. ll_cursor = SET("CURSOR") = "ON"
  189. SET CURSOR ON
  190. lc_display = SET("DISPLAY")
  191. {
  192.   set_screen_mode();
  193. }
  194. lc_status = SET("STATUS")
  195. *-- SET STATUS was \
  196. {if dB_status then}
  197. ON when you went into the Forms Designer.
  198. IF lc_status = "OFF"
  199.    SET STATUS ON
  200. {else}
  201. OFF when you went into the Forms Designer.
  202. IF lc_status = "ON"
  203.    SET STATUS OFF
  204. {endif}
  205. ENDIF
  206. //-----------------------------------------------------------------------
  207. // Process fields to build "SET CARRY" and WINDOW commands.
  208. //-----------------------------------------------------------------------
  209. {
  210.   foreach FLD_ELEMENT flds
  211.     if FLD_CARRY then 
  212.       carry_flg = 1; 
  213.       ++carry_cnt ;
  214.     endif
  215.     if chr(FLD_VALUE_TYPE) == "M" and FLD_MEM_TYP and wnd_cnt < 20 then
  216.       ++wnd_cnt;
  217.       wnd_names = wnd_names + "wndow" + wnd_cnt + ",";
  218.       new_page(flds);
  219. }
  220.  
  221. *-- Window for memo field {cap_first(FLD_FIELDNAME)}.
  222. DEFINE WINDOW { Window_Def(flds)}\
  223. {   endif
  224.   next flds
  225.   print(crlf);
  226.   if carry_flg then
  227. }
  228.  
  229. ll_carry = SET("CARRY") = "ON"
  230. SET CARRY ON
  231. *-- Fields to carry forward during APPEND.
  232. SET CARRY TO{tabto(41)}&& Clear previous SET CARRY TO list
  233. SET CARRY TO { Carry_Flds()}
  234.  
  235. {endif}
  236. {
  237.   if check_for_popups() then
  238. }
  239.  
  240. ON KEY LABEL F2 ?? chr(7)
  241.  
  242. {   output_set_proc_code();}
  243. DO S_{procedure_name}{tabto(41)}&& Open up Lookup Files
  244.  
  245. {   endif
  246.     if check_for_help() then
  247.       if !is_popup then}
  248. {         output_set_proc_code();}
  249. {       endif}
  250. ON KEY LABEL F1 DO Help WITH VARREAD()
  251. { endif
  252. return;
  253. // eof - fmt_file_init()
  254. enddef
  255.  
  256. //--------------------------------------------------------------
  257. define fmt_file_body()
  258.   var and_loc,
  259.       or_loc;
  260. }
  261.  
  262. *-- @ SAY GETS Processing. -----------------------------------------------------
  263.  
  264. *--  Format Page: {page_cnt = 1
  265.                    page_cnt}
  266.  
  267. {line_cnt = wnd_cnt = 0
  268.  foreach ELEMENT k
  269.    color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  270.    if new_page(k) then
  271. }
  272. READ
  273.  
  274. *-- Format Page: {page_cnt}
  275.  
  276. {  endif
  277. //
  278.  
  279.    if ELEMENT_TYPE == @TEXT_ELEMENT or ELEMENT_TYPE == @FLD_ELEMENT then
  280.      if FLD_FIELDTYPE == calc then
  281. }
  282. *-- Calculated field: {cap_first(FLD_FIELDNAME)} - {FLD_DESCRIPT}
  283. {    endif
  284.      if FLD_FIELDTYPE == memvar then
  285. }
  286. *-- Memory variable: {cap_first(FLD_FIELDNAME)}
  287. {    endif}
  288. @ {nul2zero(ROW_POSITN) - line_cnt},{nul2zero(COL_POSITN)} \
  289. {  endif
  290.    if ELEMENT_TYPE == @BOX_ELEMENT then
  291. }
  292. @ {box_coordinates(k)}\
  293. {  endif}
  294. //
  295. {  case ELEMENT_TYPE of
  296.    @TEXT_ELEMENT:
  297.    // Certain control characters can cause dBASE problems ie, ASCII(13,26,0)
  298.    // so the form designer will either send them to us as a string if they are
  299.    // all the same character or as individual characters if they differ. We
  300.    // handle this by using the chr() function to "SAY" them in dBASE.
  301. }
  302. SAY \
  303. {     if asc(TEXT_ITEM) < 32 then
  304.         if len(TEXT_ITEM) == 1 then}
  305. CHR({asc(TEXT_ITEM)}) \
  306. {       else}
  307. REPLICATE(CHR({asc(TEXT_ITEM)}), {len(TEXT_ITEM)}) \
  308. {       endif
  309.       else
  310.          if substr(TEXT_ITEM,1,1) == "\"" then
  311.             // Double quote is being used on the design surface need to use
  312.             // brackets "[]" as delimiters
  313.             left_delimiter = "["
  314.             right_delimiter = "]"
  315.          endif
  316.          left_delimiter + TEXT_ITEM + right_delimiter} \
  317. {        left_delimiter = right_delimiter = "\""
  318.       endif
  319.       outcolor()}
  320. {  @Box_element:
  321.        outbox(BOX_TYPE, BOX_SPECIAL_CHAR)}
  322. {      outcolor()}
  323. {  @FLD_ELEMENT:
  324.       if !FLD_EDITABLE then; // its a SAY}
  325. SAY \
  326. {        if FLD_FIELDTYPE == calc then
  327.            // Loop thru expression in case it is longer than 237
  328.             foreach FLD_EXPRESSION fcursor in k
  329.                FLD_EXPRESSION}
  330. {           next}
  331. // Output a space after the Fld_expression and get ready for picture clause
  332.  \
  333. {        else // not a editable field
  334.             if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
  335.                temp + cap_first(FLD_FIELDNAME)} \
  336. {        endif
  337.          if Ok_Template(k) then}
  338. PICTURE "{picture_for_say(k);}" \
  339. {        endif
  340.       else // it's a get}
  341. GET \
  342. {        if FLD_FIELDTYPE == dbf then 
  343.            temp = "" 
  344.            if !master_file then
  345.              master_file = FLD_FILENAME
  346.            endif
  347.          else 
  348.            temp = "m->" 
  349.          endif
  350.          temp + cap_first(FLD_FIELDNAME)} \
  351. {        if chr(FLD_VALUE_TYPE) == "M" && FLD_MEM_TYP then
  352.             if wnd_cnt < 20  then ++wnd_cnt endif
  353.             if Fld_mem_typ == 1}OPEN {endif}WINDOW wndow{wnd_cnt} \
  354. {        endif
  355.          if Ok_Template(k) then}
  356. PICTURE {picture_for_get(k);} \
  357. {        endif
  358.          if FLD_L_BOUND or FLD_U_BOUND then color_flg = 1;}
  359. ;
  360.    RANGE {if range_require & FLD_EDITABLE then}REQUIRED {endif}\
  361. {  FLD_L_BOUND}{if FLD_U_BOUND then},{FLD_U_BOUND}{endif} \
  362. {        endif
  363.          if FLD_OK_COND then color_flg = 1;}
  364. ;
  365. {           if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" and
  366.                ok_coordinates( k, 2, 1, bad_pick ) then
  367.                // A POPUP is desired for showing coded values, redo the
  368.                // VALID clause to call a UDF based on "U_" + FLD_FIELDNAME
  369. }
  370.    VALID {    if valid_required & FLD_EDITABLE ||
  371.                  is_required( FLD_OK_COND )       then}REQUIRED {endif}\
  372. {  get_udfname(FLD_FIELDNAME)}( {cap_first(FLD_FIELDNAME)} ) \
  373. {             and_loc = at( ".AND.", upper(FLD_OK_COND) );
  374.               if and_loc > 0 then
  375.                 substr( FLD_OK_COND, and_loc )} \
  376. {             endif
  377.             else
  378.                 if !(at("POPUP", upper(ltrim(FLD_OK_COND))) == "2") then
  379. }
  380.    VALID {if valid_required & FLD_EDITABLE then}REQUIRED {endif}{FLD_OK_COND} \
  381. {
  382.                 endif
  383.             endif
  384.  
  385.             if FLD_REJ_MSG then}
  386. ;
  387.    ERROR \
  388. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif}{FLD_REJ_MSG}\
  389. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif} \
  390. {           endif
  391.          endif // FLD_OK_COND
  392.          if FLD_ED_COND then color_flg = 1;}
  393. ;
  394.    WHEN {FLD_ED_COND} \
  395. {
  396.          endif
  397.          if FLD_DEF_VAL then color_flg = 1;}
  398. ;
  399.    DEFAULT {FLD_DEF_VAL} \
  400. {        endif
  401.          if FLD_HLP_MSG then color_flg = 1;}
  402. ;
  403.    MESSAGE \
  404. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif}{FLD_HLP_MSG}\
  405. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif} \
  406. {        endif
  407.       endif // FLD_EDITABLE
  408. }
  409. {     outcolor()}
  410. {     color_flg = 0;
  411.    otherwise: goto getnext;
  412.    endcase
  413. }
  414.  
  415. //Leave the above blank line, it forces a line feed!
  416. //-----------------
  417. // End of @ SAY GET
  418. //-----------------
  419. {  ++cnt;
  420.    getnext:
  421.  next k
  422. return;
  423. // eof - fmt_file_body()
  424. enddef
  425.  
  426. //--------------------------------------------------------------
  427. define fmt_file_exit()
  428. }
  429. *-- Format file exit code -----------------------------------------------------
  430.  
  431. *-- SET STATUS was \
  432. {if dB_status then}
  433. ON when you went into the Forms Designer.
  434. IF lc_status = "OFF"  && Entered form with status off
  435.    SET STATUS OFF     && Turn STATUS "OFF" on the way out
  436. {else}
  437. OFF when you went into the Forms Designer.
  438. IF lc_status = "ON"  && Entered form with status on
  439.    SET STATUS ON     && Turn STATUS "ON" on the way out
  440. {endif}
  441. ENDIF
  442. {if carry_flg then}
  443. IF .NOT. ll_carry
  444.   SET CARRY OFF
  445. ENDIF
  446. {endif}
  447. IF .NOT. ll_cursor
  448.   SET CURSOR OFF
  449. ENDIF
  450.  
  451. IF SET( "DISPLAY" ) <> lc_display
  452.   SET DISPLAY TO &lc_display.      && Reset Screen size if changed
  453. ENDIF
  454.  
  455. {if wnd_names then}
  456. RELEASE WINDOWS {substr(wnd_names, 1, (len(wnd_names) - 1))}
  457. {endif}
  458.  
  459. RELEASE {if carry_flg then}ll_carry,{endif}lc_fields,lc_status
  460. {    if is_help then}
  461.  
  462. ON KEY LABEL F1
  463. {    endif
  464.      if is_popup or is_help then}
  465. ON KEY LABEL F2
  466. {      if is_popup then}
  467. DO C_{procedure_name}{tabto(41)}&& Close up Lookup Files
  468. {      endif}
  469. SET PROCEDURE TO (lc_proc){tabto(41)}&& Re-Establish any open procedure file
  470. RELEASE lc_proc
  471. {    endif}
  472. IF TYPE( "ll_echo" ) = "L"
  473.   IF ll_echo
  474.     SET ECHO ON
  475.   ENDIF
  476. ENDIF
  477. IF ll_talk
  478.   SET TALK ON
  479. ENDIF
  480. *-- EOP: {filename(fmt_name)}FMT
  481. {return;
  482. // eof - fmt_file_exit()
  483. enddef
  484.  
  485. define picture_for_get(c)
  486. //--------------------------------------------------------------
  487. // DESCRIPTION
  488. //   Build a dBASE Picture template for a @ GET command
  489. //
  490. //--------------------------------------------------------------
  491.   if at("\"", c.FLD_TEMPLATE) or at("'", c.FLD_TEMPLATE)then
  492.     left_delimiter = "["
  493.     right_delimiter = "]";
  494.   endif
  495.   left_delimiter}
  496. { if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  497. {   if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  498.  {//leave this space}\
  499. { endif
  500.   if at("M", c.FLD_PICFUN) then
  501.     c.FLD_PIC_CHOICE}\
  502. { else
  503.     c.FLD_TEMPLATE}\
  504. { endif
  505.   right_delimiter}
  506. { left_delimiter = right_delimiter = "\""
  507.  return;
  508. enddef
  509.  
  510. //--------------------------------------------------------------
  511. define picture_for_say(c)
  512.      if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  513. {       if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  514.  {//leave this space}\
  515. {       endif
  516.      if !at("M", c.FLD_PICFUN) then
  517.         c.FLD_TEMPLATE}\
  518. {    endif
  519.  return;
  520. enddef
  521.  
  522. define make_pop_code()
  523. //--------------------------------------------------------------
  524. // Create the Procedure File for POPUP's if required
  525. //--------------------------------------------------------------
  526.   var lookup_dbf,   // store get_file(text_line1) for faster processing
  527.       look_alias,   // Lookup alias, diff from DBF if DBF starts with number
  528.       look_1st,     // 1st char of lookup DBF file
  529.       is_format,    // is there a format file
  530.       fmt_name,     // Name of the format file to use with browse
  531.       temp_name,    // store get_popname(text_line1)
  532.       prompt_field, // Name of field to build popup with
  533.       temp_key,
  534.       tag_name,     // tag name for the order
  535.       temp_org_file,// store get_org_file( text_line1 )
  536.       lookup_alias_on_form,
  537.       lookup_dbf_matches,
  538.       is_in_detail  // Flag for in a detail region
  539.       ;
  540.   if is_popup then
  541.     if !make_udf() then 
  542.       return 0;
  543.     endif
  544.     udf_header()
  545.  
  546. }
  547. PROCEDURE S_{procedure_name}
  548. *--------------------------------------------------------------------------------
  549. * DESCRIPTION
  550. *   Open data (.dbf) files for Lookup operations & faster processing
  551. *--------------------------------------------------------------------------------
  552.   PRIVATE lc_alias, ll_esc
  553.   ll_esc = SET( "ESCAPE" ) = "ON"
  554.   SET ESCAPE OFF
  555.   lc_alias = ALIAS(){tabto(41)}&& Capture current alias
  556.  
  557. {   foreach FLD_ELEMENT flds
  558.       at_pop = at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" ? 1 : 0;
  559.       if at_pop then
  560.         lookup_dbf = Cap_first( get_file(FLD_OK_COND) );
  561.         look_1st = ASC( substr( lookup_dbf, 1, 1 ) );
  562.         look_alias = ( look_1st > 47 && look_1st < 58 ) ? 
  563.                         "A" + lookup_dbf : lookup_dbf;
  564.         tag_name = get_key(FLD_OK_COND);
  565.         prompt_field = get_field(FLD_OK_COND);
  566.         lookup_dbf_matches = (upper(lookup_dbf) == FLD_FILENAME) ?
  567.                                     TRUE : FALSE;
  568.         if not at("," + lookup_dbf, workarea_dbfs) then
  569.           workarea_dbfs = workarea_dbfs + "," + lookup_dbf;
  570. }
  571.   IF TYPE("g_{lower(lookup_dbf)}") = "U"
  572.     PUBLIC g_{lower(lookup_dbf)}
  573.  
  574.     IF SELECT("{lookup_dbf}") = 0
  575.       IF FILE( "{lookup_dbf}.DBF" )
  576.         SELECT SELECT()
  577.         USE {lookup_dbf} NOLOG ALIAS {look_alias}
  578.         g_{lower(lookup_dbf)} = 1{tabto(41)}&& File was opened for the first time
  579.         IF TAGNO( "{tag_name}" ) = 0
  580.           DO _Err_Box WITH [{tag_err} ] + [{tag_name}]
  581.           USE
  582.           RELEASE g_{lower(lookup_dbf)}
  583.           RELEASE gl_{lookup_dbf}
  584.           PUBLIC gl_{lookup_dbf}
  585.         ENDIF
  586.         IF TYPE( "{look_alias}->{prompt_field}" ) = "U"
  587.           DO _Err_Box WITH [{var_err} ] + [{look_alias}->{prompt_field}]
  588.           USE
  589.           RELEASE g_{lower(lookup_dbf)}
  590.           RELEASE gl_{lookup_dbf}
  591.           PUBLIC gl_{lookup_dbf}
  592.         ENDIF  
  593.       ELSE
  594.         DO _Err_Box WITH "{lookup_dbf}.DBF " + [{file_err}]
  595.         RELEASE g_{lower(lookup_dbf)}
  596.         RELEASE gl_{lookup_dbf}
  597.         PUBLIC gl_{lookup_dbf}
  598.       ENDIF
  599.     ELSE
  600.       g_{lower(lookup_dbf)} = 2{tabto(41)}&& File was opened outside of this program
  601.     ENDIF
  602.  
  603.   ELSE
  604.     *-- File was already opened by a program generated from Form.gen
  605.     g_{lower(lookup_dbf)} = g_{lower(lookup_dbf)} + 1
  606.   ENDIF
  607.  
  608. {       endif
  609.       endif
  610.     next;
  611. }
  612.   SELECT ( lc_alias )
  613.   IF ll_esc
  614.     SET ESCAPE ON
  615.   ENDIF
  616. RETURN
  617. *-- EOP: S_{procedure_name}
  618.  
  619.  
  620. PROCEDURE C_{procedure_name}
  621. *--------------------------------------------------------------------------------
  622. * DESCRIPTION
  623. *   Close Lookup files on exit of the .fmt, if they are not used
  624. *   by other calling .fmt files
  625. *--------------------------------------------------------------------------------
  626.   PRIVATE ll_esc
  627.   ll_esc = SET( "ESCAPE" ) = "ON"
  628.   SET ESCAPE OFF
  629. {   workarea_dbfs = ""
  630.     foreach FLD_ELEMENT flds
  631.       at_pop = at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" ? 1 : 0;
  632.       if at_pop then
  633.         lookup_dbf = get_file(FLD_OK_COND)
  634.         look_1st = ASC( substr( lookup_dbf, 1, 1 ) );
  635.         look_alias = ( look_1st > 47 && look_1st < 58 ) ? 
  636.                         "A" + lookup_dbf : lookup_dbf;
  637.         if not at("," + lookup_dbf, workarea_dbfs) then
  638.           workarea_dbfs = workarea_dbfs + "," + lookup_dbf;
  639. }
  640.   DO CASE
  641.     CASE TYPE("g_{lower(lookup_dbf)}") = "U"
  642.       *-- Exiting out of the form!  Lookup file was not opened up properly
  643.       RELEASE gl_{lookup_dbf}
  644.     CASE g_{lower(lookup_dbf)} = 1
  645.       USE IN {look_alias}
  646.       RELEASE g_{lower(lookup_dbf)}
  647.     OTHERWISE
  648.       g_{lower(lookup_dbf)} = g_{lower(lookup_dbf)} - 1
  649.   ENDCASE
  650. {       endif
  651.       endif
  652.     next;
  653. }
  654.  
  655.   IF ll_esc
  656.     SET ESCAPE ON
  657.   ENDIF
  658. RETURN
  659. *-- EOP: C_{procedure_name}
  660.  
  661. {         line_cnt = lookup_cnt = 0
  662.           page_cnt = 1
  663.  
  664.           foreach FLD_ELEMENT flds
  665.  
  666.                at_pop = at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" ? 1 : 0;
  667.  
  668.                new_page(flds)
  669.                if at_pop then
  670.                     trow_positn = nul2zero(ROW_POSITN) - line_cnt
  671.                     tcol_positn = nul2zero(COL_POSITN)
  672.                     lookup_dbf = get_file(FLD_OK_COND);
  673.                     look_1st = ASC( substr( lookup_dbf, 1, 1 ) );
  674.                     look_alias = ( look_1st > 47 && look_1st < 58 ) ? 
  675.                                  "A" + lookup_dbf : lookup_dbf;
  676.                     tag_name = get_key(FLD_OK_COND);
  677.                     prompt_field = get_field(FLD_OK_COND);
  678.                     color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  679.  
  680.                     if !ok_coordinates(flds, 2, 0, "") then 
  681.                       loop 
  682.                     endif
  683. }
  684. FUNCTION {get_udfname(FLD_FIELDNAME)}
  685. PARAMETER fld_name
  686. *{replicate("-",69)}
  687.   PRIVATE ALL LIKE l?_*
  688.   PRIVATE esckey, fld_name, rtn_fld
  689.   ll_esc = SET( "ESCAPE" ) = "ON"
  690.   SET ESCAPE OFF
  691.   ll_return = .F.
  692.   IF TYPE( "gl_{lookup_dbf}" ) = "L"{tabto(41)}&& Was lookup file opened?
  693.     IF ll_esc{tabto(41)}&& It wasn't, so return back to the form
  694.       SET ESCAPE ON
  695.     ENDIF
  696.     RETURN(.T.){tabto(41)}&& With no data validation
  697.   ENDIF
  698. {                   if !is_required(FLD_OK_COND) then}
  699.   IF ISBLANK(fld_name){tabto(41)}&& Not a required field
  700.     IF ll_esc
  701.       SET ESCAPE ON
  702.     ENDIF
  703.     RETURN (.T.){tabto(41)}&& Return since it's a blank field
  704.   ENDIF
  705.  
  706. {                    endif}
  707.   EscKey = 27{tabto(41)}&& 27 represents the ESC key
  708.  
  709.   lc_alias = ALIAS(){tabto(41)}&& Grab current workarea
  710.   SELECT {look_alias}{tabto(41)}&& Select the lookup file
  711.   lc_order = ORDER(){tabto(41)}&& Save any existing order
  712.   SET ORDER TO {tag_name}{tabto(41)}&& Set the order to the lookup key
  713.  
  714.   ll_exact = SET("EXACT") = "ON"{tabto(41)}&& Store value of EXACT
  715.   SET EXACT ON
  716.  
  717. {                   if chr(FLD_VALUE_TYPE) == "C" then}
  718.   fld_name = IIF( ISBLANK( TRIM( fld_name)), fld_name, TRIM( fld_name))
  719. {                   endif}
  720.   SEEK fld_name
  721.  
  722.   IF .NOT. ll_exact{tabto(41)}&& Restore SET EXACT to org. value
  723.     SET EXACT OFF
  724.   ENDIF
  725.  
  726.   IF .NOT. FOUND()
  727.  
  728.     DEFINE POPUP {get_popname(FLD_OK_COND)} FROM \
  729. {         if trow_positn < max_pop_row then
  730.              trow_positn + 1},{tcol_positn} ;
  731.         TO {scrn_size-1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  732. {         else
  733.              trow_positn - 11},{tcol_positn} ;
  734.         TO {trow_positn - 1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  735. {         endif}
  736.         PROMPT FIELD {prompt_field} ;
  737.         MESSAGE {select_msg1}
  738.  
  739.     ON SELECTION POPUP {get_popname(FLD_OK_COND)} DEACTIVATE POPUP
  740.  
  741. {                        if chr(FLD_VALUE_TYPE) == "C" then}
  742.     KEYBOARD TRIM(fld_name)
  743. {                   endif}
  744.     SAVE SCREEN TO temp
  745. {                   if is_shadow(FLD_OK_COND) and
  746.                        ok_coordinates( flds, 4, 1, bad_shadow ) then
  747. }
  748.     DO shadowg WITH {get_pop_shadow(FLD_TEMPLATE);}
  749.  
  750. {                   endif
  751. }
  752.     ACTIVATE POPUP {get_popname(FLD_OK_COND)}
  753.  
  754.     rtn_fld = PROMPT(){tabto(41)}&& Get user choice from pick list
  755.     ln_bar = BAR(){tabto(41)}&& Capture bar number to check for esc
  756.  
  757.     RELEASE POPUP {get_popname(FLD_OK_COND)}
  758.  
  759.     RESTORE SCREEN FROM temp
  760.  
  761.     IF ln_bar <> 0
  762.       @ {trow_positn},{tcol_positn} GET rtn_fld \
  763. {        if Ok_Template(flds) then}
  764. PICTURE {picture_for_get(flds);} \
  765. {           outcolor()}
  766. {        endif}
  767.  
  768.       CLEAR GETS
  769.  
  770.       REPLACE {cap_first(FLD_FILENAME)}->{cap_first(FLD_FIELDNAME)} WITH \
  771. {        if chr(FLD_VALUE_TYPE) == "C" then}
  772. rtn_fld
  773. {        else}
  774. VAL(rtn_fld)
  775. {        endif}
  776.  
  777.       ll_return = .T.
  778.     ELSE
  779.       ll_return = .F.
  780. {
  781.                     if !is_required(FLD_OK_COND) then
  782. }
  783.       IF ISBLANK(fld_name){tabto(41)}&& Not a required field, so return
  784.         ll_return = .T.
  785.       ENDIF
  786.  
  787. {
  788.                     endif
  789. }
  790.     ENDIF
  791.  
  792.   ELSE
  793.     ll_return = .T.
  794.   ENDIF
  795.  
  796.   IF .NOT. ISBLANK( lc_order ){tabto(41)}&& If there was a order on lookup file
  797.     SET ORDER TO ( lc_order ){tabto(41)}&& Set it back to its original setting
  798.   ENDIF
  799.  
  800.   SELECT (lc_alias){tabto(41)}&& Go back to the edit file
  801.  
  802.   IF ll_esc
  803.     SET ESCAPE ON
  804.   ENDIF
  805. RETURN (ll_return)
  806. *-- EOP: {get_udfname(FLD_FIELDNAME)}
  807.  
  808. {
  809.                endif
  810.           next flds
  811.           print("*"+replicate("-",78)+crlf);}
  812.  
  813. {    endif
  814.      return;
  815. // eof - make_pop_code()
  816. enddef
  817.  
  818. //--------------------------------------------------------------
  819. define make_help_code()
  820. //------------------------------------
  821. // Make procedures for the help system
  822. //------------------------------------
  823. if is_help then
  824.      // If the udf file has not already been created, make it.
  825.     if not udf_file then
  826.        if !make_udf() then 
  827.            return 0;
  828.        endif
  829.        // Put up the UDF header
  830.        udf_header()
  831.     endif
  832.     // Make procedures for the help system
  833.     make_help()
  834. endif
  835. if is_help or is_popup then
  836.    // Make shadow procedures
  837.    make_shadow_procs()
  838. endif
  839. return;
  840. enddef
  841.  
  842. //--------------------------------------------------------------
  843. define header()
  844. // Print Header in program
  845.   var len_filename,
  846.       file_name;
  847.  
  848.   file_name = filename(fmt_name);
  849.   len_filename = len( file_name );
  850.   if substr( file_name, len_filename, 1 ) == "." then
  851.     file_name = substr( file_name, 1, len_filename - 1 ) + ".FMT";
  852.   else
  853.     file_name = file_name + ".FMT";
  854.   endif
  855. }
  856. *{replicate( "-", 69)}
  857. * Name.......: {file_name}
  858. * Date.......: {ltrim( substr( date(),1,8))}
  859. * Version....: dBASE IV, Format {db_version_no}
  860. * Notes......: Format files use "" as delimiters!
  861. *{replicate( "-", 69)}
  862. {
  863. enddef
  864.  
  865. //--------------------------------------------------------------
  866. define udf_header()
  867. // Print Header in UDF program
  868.   var len_filename,
  869.       file_name;
  870.  
  871.   file_name = filename(fmt_name);
  872.   len_filename = len( file_name );
  873.   if substr( file_name, len_filename, 1 ) == "." then
  874.     file_name = substr( file_name, 1, len_filename - 1 ) + ".FMT";
  875.   else
  876.     file_name = file_name + ".FMT";
  877.   endif
  878. }
  879. *{replicate( "-", 69)}
  880. * Name....: U_{rtrim(substr(name,1,6))}.PRG
  881. * Date....: {ltrim(SUBSTR(date(),1,8))}
  882. * Version.: dBASE IV, Procedure for Format {db_version_no}
  883. * Notes...: Procedure file for VALID POPUPs and/or Context Sensitive Help
  884. *           for {file_name}
  885. { if master_file then}
  886. *           The Master file for the form is assumed to be {master_file}.
  887. { endif}
  888. *{replicate( "-", 69)}
  889. { lmarg(offset)}
  890. PRIVATE ll_oldtalk
  891. IF SET( "TALK" ) = "ON"
  892.   SET TALK OFF
  893.   ll_oldtalk = .T.
  894. ELSE
  895.   ll_oldtalk = .F.
  896. ENDIF
  897.  
  898. *-- {can_not_run}
  899. DO _Err_Box WITH "{can_not_run}"
  900.  
  901. IF ll_oldtalk
  902.   SET TALK ON
  903. ENDIF
  904. {   lmarg(0)}
  905. RETURN
  906.  
  907.  
  908. {
  909. enddef
  910.  
  911. //--------------------------------------------------------------
  912. define ok_template(cur)
  913.      if cur.FLD_TEMPLATE && !(chr(cur.FLD_VALUE_TYPE) == "D" ||
  914.                               chr(cur.FLD_VALUE_TYPE) == "M") then
  915.         return 1;
  916.      else
  917.         return 0;
  918.      endif
  919. enddef
  920.  
  921. //--------------------------------------------------------------
  922. define ok_coordinates(cur,              // Current cursor
  923.                       xtra_width,       // Additional width to check ie, shadow
  924.                       want_message,     // Display message flag 0:No 1:Yes
  925.                       message)          // Message to display to user
  926.      // Check to see if coordinates of popup or shadow will fit on screen
  927.      // based on the dimensions of the current field
  928.      if nul2zero(cur.COL_POSITN) + len(cur.FLD_TEMPLATE) + xtra_width > 80 then
  929.         if want_message then
  930.            beep(2)                      // UDF in builtin.def
  931.            cls()
  932.            say_center(10,"Error on Field: " + cur.FLD_FIELDNAME)
  933.            say_center(12, message)
  934.            pause(any_key)
  935.         endif
  936.         return 0;
  937.      else
  938.         return 1;
  939.      endif
  940. enddef
  941.  
  942. //--------------------------------------------------------------
  943. define getcolor(f_display,         // Color of the current field
  944.                 f_editable         // Field is SAY or GET
  945.                )
  946.  // Determines the color from f_display and f_editable (GET or SAY)
  947.  enum  Foreground  =   7,
  948.        Intensity   =   8,  // Color
  949.        Background  = 112,
  950.        MIntensity  = 256,
  951.        Reverse     = 512,  // Mono
  952.        Underline   =1024,
  953.        Blink       =2048,
  954.        default     =32768; // Screen set to default
  955.  
  956.  var forgrnd, enhanced, backgrnd, blnk, underln, revrse, use_colors, incolor;
  957.  incolor=""
  958.  
  959.  use_colors  = default & f_display
  960.  forgrnd  = Foreground & f_display
  961.  enhanced = (Intensity & f_display) || (MIntensity & f_display)
  962.  backgrnd = Background & f_display
  963.  blnk     = Blink  & f_display
  964.  underln  = Underline & f_display
  965.  revrse   = Reverse & f_display
  966.  
  967.  if not use_colors then // Use system colors, no colors set in designer
  968.  
  969.     if backgrnd then backgrnd = backgrnd/16 endif
  970.  
  971.     if (display != mono and display != mono43) then
  972.        case forgrnd of
  973.         0: incolor = "n"
  974.         1: incolor = "b"
  975.         2: incolor = "g"
  976.         3: incolor = "bg"
  977.         4: incolor = "r"
  978.         5: incolor = "rb"
  979.         6: incolor = "gr"
  980.         7: incolor = "w"
  981.        endcase
  982.     else
  983.        incolor = "w"
  984.     endif
  985.  
  986.     if revrse then
  987.        incolor = incolor + "i"
  988.     endif
  989.     if underln then
  990.        incolor = incolor + "u"
  991.     endif
  992.     if enhanced then
  993.        incolor = incolor + "+"
  994.     endif
  995.     if blnk then
  996.        incolor = incolor + "*"
  997.     endif
  998.  
  999.     incolor = incolor + "/"
  1000.  
  1001.     if (display != mono and display != mono43) then
  1002.        case backgrnd of
  1003.         0: incolor = incolor + "n"
  1004.         1: incolor = incolor + "b"
  1005.         2: incolor = incolor + "g"
  1006.         3: incolor = incolor + "bg"
  1007.         4: incolor = incolor + "r"
  1008.         5: incolor = incolor + "rb"
  1009.         6: incolor = incolor + "gr"
  1010.         7: incolor = incolor + "w"
  1011.        endcase
  1012.     else
  1013.        incolor = incolor + "n"
  1014.     endif
  1015.  
  1016.     if f_editable and incolor then
  1017.        incolor = incolor + "," + incolor
  1018.     endif
  1019.  
  1020.  endif // use no colors
  1021.  return alltrim(incolor);
  1022. enddef
  1023.  
  1024. //--------------------------------------------------------------
  1025. define outbox(mbox,            // Border type
  1026.               mchar            // Special character of border
  1027.              )
  1028.    // Output the of Box border and character if any
  1029.    var result;
  1030.    case mbox of
  1031.       0: result = " " // single
  1032.       1: result = " DOUBLE "
  1033.       2: result = " CHR("+mchar+") "
  1034.    endcase
  1035.    return result;
  1036. enddef
  1037.  
  1038. //--------------------------------------------------------------
  1039. define outcolor()
  1040.   // Output the of color of the @ SAY GET or Box
  1041.   var result;
  1042.   result = "";
  1043.   if len(color) > 0 then
  1044.      if color_flg then
  1045.         // If flag is set output a dBASE continuation ";"
  1046.         result = ";" + crlf + space(3)
  1047.      endif
  1048.      result = result + "COLOR " + color + " "
  1049.   endif
  1050.   return result;
  1051. enddef
  1052.  
  1053. //--------------------------------------------------------------
  1054. define window_def(cur)
  1055.    // Build dBASE window command
  1056.    var result;
  1057.    result = "wndow" + wnd_cnt + " FROM " + Box_Coordinates(cur);
  1058.    result = result + outbox(cur.BOX_TYPE, cur.BOX_SPECIAL_CHAR);
  1059.    color = getcolor(cur.FLD_DISPLAY, cur.FLD_EDITABLE);
  1060.    result = result + outcolor();
  1061.    return result;
  1062. enddef
  1063.  
  1064. //--------------------------------------------------------------
  1065. define box_coordinates(cur)             // Pass in foreach cursor
  1066. //
  1067. // Build box coordinates for a dBASE window command
  1068. //
  1069.   var result, temp_page, line_cnt, cur_box_top, cur_row_positn,
  1070.       scrn_num4_win, scrn_num4_fld, cur_box_left;
  1071.  
  1072.   cur_box_top    = nul2zero(cur.BOX_TOP);
  1073.   cur_row_positn = nul2zero(cur.ROW_POSITN);
  1074.   cur_box_left   = nul2zero(cur.BOX_LEFT);
  1075.   
  1076.   if cur.FLD_MEM_TYP then                   // If MEMO window
  1077.     scrn_num4_win = cur_box_top / scrn_size;
  1078.     scrn_num4_fld = cur_row_positn / scrn_size;
  1079.     if scrn_num4_win != scrn_num4_fld then  // If window not on same screen
  1080.       cur_box_top = ( cur_box_top % scrn_size ) + scrn_size + 1;
  1081.     endif
  1082.   endif
  1083.  
  1084.   temp_page = cur_box_top / scrn_size;
  1085.   line_cnt = (scrn_size * temp_page) + (1 * temp_page);
  1086.  
  1087.   result = cur_box_top - line_cnt +",";
  1088.   result = result + cur_box_left + " TO ";
  1089.   temp = cur_box_top + cur.BOX_HEIGHT - line_cnt - 1;
  1090.   if temp > scrn_size then
  1091.     temp = scrn_size;
  1092.   endif
  1093.   result = result + temp + "," + ( cur_box_left + cur.BOX_WIDTH - 1 );
  1094.   return result;
  1095. enddef
  1096.  
  1097.  
  1098. //--------------------------------------------------------------
  1099. define carry_flds()
  1100.    // Build dBASE SET CARRY command
  1101.    carry_len = carry_lent = 13
  1102.    carry_first = 0
  1103.    foreach FLD_ELEMENT flds
  1104.       if FLD_CARRY then
  1105.          carry_len = carry_len + len(FLD_FIELDNAME + ",")
  1106.          carry_lent = carry_lent + len(FLD_FIELDNAME + ",")
  1107.          if carry_lent > 1000 then
  1108.             print(crlf + "SET CARRY TO ")
  1109.             carry_len = carry_lent = 13
  1110.          endif
  1111.          if carry_len > 75 then print(";" + crlf + "  ")  carry_len = 2 endif
  1112.          temp = cap_first(FLD_FIELDNAME)
  1113.          if !carry_first then
  1114.             print(temp)
  1115.             carry_first = 1
  1116.          else
  1117.             print("," + temp)
  1118.          endif
  1119.       endif
  1120.     next flds
  1121.     print(" ADDITIVE");
  1122.  return;
  1123. enddef
  1124.  
  1125. //--------------------------------------------------------------
  1126.  
  1127. define make_fmt()
  1128.    // Attempt to create program (fmt) file.
  1129.    default_drv = strset(_defdrive)  // grab default drive from dBASE
  1130.    fmt_name = FRAME_PATH + NAME     // Put path on to object name
  1131.    if not fileok(fmt_name) then
  1132.       if !default_drv then
  1133.          fmt_name = NAME
  1134.       else
  1135.          fmt_name = default_drv + ":" + NAME
  1136.       endif
  1137.    endif
  1138. //   fmt_name = upper(fmt_name)
  1139.    if not create(fmt_name+".fmt") then
  1140.         pause(fileroot(fmt_name) +".fmt" + read_only + any_key)
  1141.         return 0;
  1142.      endif
  1143.    return 1;
  1144. enddef
  1145. //--------------------------------------------------------------
  1146.  
  1147. define make_udf()
  1148.    // Attempt to create dBASE procedure (prg) file.
  1149.    var udf_root_file_name;
  1150.    udf_root_file_name =  frame_path + "u_" + rtrim(substr(name,1,6))
  1151.    if not create( udf_root_file_name + ".prg") then
  1152.       pause(udf_root_file_name + ".prg" + read_only + any_key)
  1153.       return 0;
  1154.    endif
  1155.    // Force dBASE to recompile the .prg
  1156.    fileerase(udf_root_file_name + ".DBO")
  1157.    udf_file = 1 // Global flag to determine if UDF file was created
  1158.    return 1;
  1159. enddef
  1160.  
  1161. //--------------------------------------------------------------
  1162. define check_for_popups()
  1163. // Check for "popup" string for this fmt file
  1164. foreach FLD_ELEMENT flds
  1165.     if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" then
  1166.        is_popup = 1
  1167.        exit
  1168.     endif
  1169. next flds
  1170. return is_popup;
  1171. enddef
  1172.  
  1173. //--------------------------------------------------------------
  1174. define check_for_help()
  1175.    // Check for help support for this fmt file
  1176.    // Looking for a .dBF with the same name as the .fmt file
  1177.    hlp_name = frame_path + substr(fileroot(fmt_name), 1, 6) + "_H"
  1178.  
  1179.    if fileexist(hlp_name + ".dbf") and fileexist(hlp_name + ".dbt") then
  1180.       is_help = 1      // Global flag for help support
  1181.    endif
  1182. return is_help;
  1183. enddef
  1184.  
  1185. define new_page(cur)               // Pass in foreach cursor
  1186. //----------------------------------------------------------------------
  1187. // NAME
  1188. //   New_Page - Check for a page break and adjusts line_cnt and page_cnt
  1189. //
  1190. // DESCRIPTION
  1191. //   New_Page() will determine the top line on the screen for the
  1192. //   object specified by the cursor <cur> and is assigned to the
  1193. //   global variable, <line_cnt>.  If the object is on a new page, 
  1194. //   the global variable, <page_cnt>, is adjusted to the new page.
  1195. //   
  1196. //   New_Page() will return a TRUE value if a page break occured, 
  1197. //   otherwise it will return a FALSE value.
  1198. //   
  1199. // EXAMPLE
  1200. //     foreach ELEMENT k
  1201. //       if new_page( k )
  1202. //         ... page break occured
  1203. //       endif
  1204. //     next k;
  1205. //
  1206. // GLOBAL VARIABLES
  1207. //   line_cnt = line number for the top line on the given page
  1208. //   page_cnt = page number for the object, starting at 1
  1209. //
  1210. //----------------------------------------------------------------------
  1211.   var cur_row_positn, 
  1212.       temp_page;
  1213.  
  1214.   cur_row_positn = nul2zero( cur.ROW_POSITN )
  1215.  
  1216.   if cur_row_positn - line_cnt > scrn_size then
  1217.     temp_page = cur_row_positn / scrn_size
  1218.     line_cnt = (scrn_size * temp_page) + (1 * temp_page)
  1219.     page_cnt = temp_page + 1
  1220.     return TRUE;
  1221.   endif
  1222. return FALSE;
  1223. enddef
  1224.  
  1225. //--------------------------------------------------------------
  1226. define parse_line( before,         // Out: chars before the look_for string
  1227.                    input,          // In:  line being parsed
  1228.                    look_for        // In:  string searched for
  1229.                  )                 // Rtn: chars after the look_for string
  1230. // If the look_for sting is not found, the before sting will equal the
  1231. // input string, and the returned value will be NUL
  1232.      var location;
  1233.  
  1234.      location = at(look_for, UPPER(input))
  1235.      if location == 0 then
  1236.           before = input
  1237.           return ( "" );
  1238.      endif
  1239.  
  1240.      before = substr( input, 1, location-1)
  1241.      return ( substr( input,
  1242.                       location+len(look_for),
  1243.                       len(input)
  1244.                     )
  1245.             );
  1246.  
  1247. // end: parse_line()
  1248. enddef
  1249.  
  1250. //--------------------------------------------------------------
  1251. // Parsing routines for pulling objects out of the VALID string
  1252. // "POPUP" = "file->fld_name ORDER key_fld REQ"
  1253. // 1234567890123456789012345678901234567890123
  1254. //            1         2         3         4
  1255. define get_file(valid_str)
  1256.      var  s_arrow,            // String "->"
  1257.           test,
  1258.           s_equal,            // String "="
  1259.           next_alpha,
  1260.           at_alias,
  1261.           s_before,           // String before the searched for item
  1262.           r_target,           // Remainder of the target string after item
  1263.           use_name;           // Return for file
  1264.  
  1265.      s_arrow = "->"
  1266.      s_equal = "="
  1267.      r_target = parse_line( s_before, valid_str, s_equal )      // ' "file->...'
  1268.      next_alpha = atalpha(r_target)                             // 3
  1269.      at_alias = at(s_arrow, r_target)                           // 7
  1270.      use_name = substr(r_target,next_alpha,at_alias-next_alpha) // 'file'
  1271.  
  1272.      return cap_first(use_name);
  1273. enddef
  1274.  
  1275. //--------------------------------------------------------------
  1276. define get_key(valid_str)
  1277.      var  s_order,            // String "ORDER "
  1278.           at_space,
  1279.           q_space,
  1280.           s_before,           // String before the searched for item
  1281.           r_target,           // Remainder of the target string after item
  1282.           order_tag;          // Search TAG to ORDER BY
  1283.  
  1284.      s_order = "ORDER "
  1285.      r_target = parse_line( s_before, valid_str, s_order ) // 'key_fld REQ'
  1286.      at_space = at(" ",r_target)
  1287.      if at_space == 0 then
  1288.           order_tag = substr(r_target, 1, len(r_target)-1) // 'key_fld"'
  1289.      else
  1290.           q_space = at('"',r_target)
  1291.           if q_space != 0 && q_space < at_space then
  1292.                order_tag = substr(r_target, 1, q_space-1)
  1293.           else
  1294.                order_tag = substr(r_target, 1, at_space-1)
  1295.           endif
  1296.      endif
  1297.      return cap_first(order_tag);
  1298. enddef
  1299.  
  1300. //--------------------------------------------------------------
  1301. define get_field(valid_str)
  1302.      var  s_arrow,            // String "->"
  1303.           at_space,
  1304.           s_before,           // String before the searched for item
  1305.           r_target,           // Remainder of the target string after item
  1306.           fld_name;           // Field name to lookup in target file
  1307.  
  1308.      s_arrow = "->"
  1309.      r_target = parse_line( s_before,
  1310.                             valid_str, s_arrow ) // 'fld_name ORDER...'
  1311.      at_space = at(" ",r_target)
  1312.  
  1313.      fld_name = ( at_space == 0 ? r_target : substr(r_target, 1, at_space-1) );
  1314.  
  1315.      return cap_first(fld_name);
  1316. enddef
  1317.  
  1318. //--------------------------------------------------------------
  1319. define get_popname(valid_str)
  1320.      // Create popup name
  1321.      return ( lower( "u_" + substr( get_field( valid_str),1,6) ) );
  1322. enddef
  1323.  
  1324. //--------------------------------------------------------------
  1325. define get_pop_shadow(field_template)   // Pass in FLD_TEMPLATE to deter. shadow
  1326.      if trow_positn < max_pop_row then
  1327.         trow_positn + 1},{tcol_positn},{scrn_size-1},{tcol_positn+len(Field_template)+1}
  1328. {    else
  1329.         trow_positn - 11},{tcol_positn},{trow_positn - 1},{tcol_positn+len(Field_template)+1}
  1330. {    endif
  1331.      return;
  1332. enddef
  1333.  
  1334. //---------------------------------------------------------------
  1335. define get_udfname(fld_str)
  1336.      // Create UDF name
  1337.      return cap_first( "u_" + substr( fld_str,1,6) );
  1338. enddef
  1339.  
  1340. //--------------------------------------------------------------
  1341. define is_required(valid_str)
  1342.      // Determines if the field is required before moving to the next field
  1343.      return ( ( at(" REQ ",  upper(valid_str)) ? 1 : 0 ) or 
  1344.               ( at(" REQ\"", upper(valid_str)) ? 1 : 0 )
  1345.             );
  1346. enddef
  1347.  
  1348. //--------------------------------------------------------------
  1349. define is_shadow(valid_str)
  1350.      // Determines if the user wants shadowing for popup
  1351.      return ( ( at(" SHADOW ",  upper(valid_str)) ? 1 : 0 ) or 
  1352.               ( at(" SHADOW\"", upper(valid_str)) ? 1 : 0 )
  1353.             );
  1354. enddef
  1355.  
  1356. //--------------------------------------------------------------
  1357. define make_shadow_procs()
  1358.      // Make the dBASE code for shadowing
  1359. }
  1360. PROCEDURE Shadowg
  1361. *{replicate("-",69)}
  1362. * DESCRIPTION
  1363. *   Displays shadow that grows.  Specify the same coord and the
  1364. *   window or popup to shadow.
  1365. *{replicate("-",69)}
  1366.   PARAMETER x1,y1,x2,y2
  1367.   PRIVATE   x1,y1,x2,y2
  1368.  
  1369.   x0 = x2+1
  1370.   y0 = y2+2
  1371.   dx = 1
  1372.   dy = (y2-y1) / (x2-x1)
  1373.   DO WHILE x0 <> x1 .OR. y0 <> y1+2
  1374.     @ x0,y0 FILL TO x2+1,y2+2 COLOR n+/n
  1375.     x0 = IIF(x0<>x1,x0 - dx,x0)
  1376.     y0 = IIF(y0<>y1+2,y0 - dy,y0)
  1377.     y0 = IIF(y0<y1+2,y1+2,y0)
  1378.   ENDDO
  1379.  
  1380. RETURN
  1381. *-- EOP: shadowg
  1382.  
  1383. {    return;
  1384. enddef
  1385.  
  1386.  
  1387. define make_general_procs()
  1388. //--------------------------------------------------------------
  1389. // Make the dBASE core routines
  1390. //--------------------------------------------------------------
  1391. }
  1392. PROCEDURE _Err_Box
  1393. PARAMETERS pc_msg
  1394. *----------------------------------------------------------------------------
  1395. * NAME
  1396. *   _Err_Box - Display an error box
  1397. *
  1398. * SYNOPSIS
  1399. *   DO _Err_Box WITH <pc_msg>
  1400. *
  1401. * DESCRIPTION
  1402. *   _Err_Box will display the <pc_msg> string in a box and prompt the
  1403. *   user to press any key to continue processing.  _Err_Box will display
  1404. *   the message based on the length of <pc_msg>.
  1405. *
  1406. * PARAMETERS
  1407. *   pc_msg - the error message to display in the box.  If the length is
  1408. *            greater than 76, the trailing part is chopped off.
  1409. *
  1410. * EXAMPLE
  1411. *   DO _Err_Box WITH "Incorrect window size"
  1412. *   Displays the message in a window as follows at row 9 on the screen:
  1413. *                      +------------------------------+
  1414. *                      |                              |
  1415. *                      |    Incorrect window size     |
  1416. *                      |                              |
  1417. *                      | Press any key to continue... |
  1418. *                      |                              |
  1419. *                      +------------------------------+
  1420. *   Note that the width of the window will increase to accommodate a longer
  1421. *   message string.
  1422. *
  1423. * LIMITATIONS
  1424. *   Truncates the message after 76 characters.  Assumes an 80 character
  1425. *   wide screen.  Looks best with SET CURSOR OFF.
  1426. *
  1427. *----------------------------------------------------------------------------
  1428.  
  1429.   PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,;
  1430.           ll_escape
  1431.  
  1432.   lc_anykey = [Press any key to continue...]
  1433.   ln_press  = LEN( lc_anykey )
  1434.   lc_win = WINDOW()                     && Currently activated window if any
  1435.   lc_msg = LTRIM( RTRIM( pc_msg ) )     && Trimmed message
  1436.   ln_msglen = LEN( lc_msg )             && Trimmed length of message
  1437.   ln_width = 0                          && Width of display area in window.
  1438.   ll_escape = SET("ESCAPE") = "ON"
  1439.   IF TYPE( "FXL_DEV" ) = "L" .AND. FXL_DEV
  1440.     SET ESCAPE ON
  1441.   ELSE
  1442.     SET ESCAPE OFF
  1443.   ENDIF
  1444.  
  1445.   *-- Determine the width needed for the window:
  1446.   IF ln_msglen <= ln_press
  1447.     ln_width = ln_press
  1448.   ELSE
  1449.     *-- Make sure the message fits in the window:
  1450.     IF ln_msglen > 76
  1451.       lc_msg = LEFT( lc_msg, 76 )
  1452.       ln_msglen = 76
  1453.     ENDIF
  1454.     ln_width = ln_msglen
  1455.   ENDIF
  1456.   DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ;
  1457.                 TO 15, (ln_width + 83) / 2 DOUBLE
  1458.   ln_width = ( ln_width + 2 )
  1459.  
  1460.   *-- Display the message and prompt to the window and wait for a key press
  1461.   ACTIVATE WINDOW _err_box
  1462.   @ 1, ( ln_width - ln_msglen ) / 2 SAY lc_msg
  1463.   @ 3, ( ln_width - ln_press ) / 2 SAY lc_anykey
  1464.   SET CONSOLE OFF                       && For mouse click recognition
  1465.   WAIT
  1466.   SET CONSOLE ON
  1467.  
  1468.   *-- Clean up the window display and reactivate the previous window
  1469.   RELEASE WINDOW _err_box
  1470.   IF ISBLANK( lc_win )
  1471.     ACTIVATE SCREEN
  1472.   ENDIF
  1473.  
  1474.   IF ll_escape
  1475.     SET ESCAPE ON
  1476.   ELSE
  1477.     SET ESCAPE OFF
  1478.   ENDIF
  1479.  
  1480. RETURN
  1481. *-- EOP: _Err_Box WITH pc_msg
  1482.  
  1483.  
  1484. FUNCTION _Rat
  1485. PARAMETERS pc_source, pc_target
  1486. *--------------------------------------------------------------------
  1487. * NAME
  1488. *   _RAT - Version of AT() that starts from right.
  1489. *
  1490. * SYNOPSIS
  1491. *   _RAT( <expC>, <expC> )
  1492. *
  1493. * DESCRIPTION
  1494. *   _RAT() takes two arguments, a source string and a target
  1495. *   string.  It searches for the first occurrence of the source
  1496. *   within the target beginning on the right end of the string,
  1497. *   and returns an integer representing the first character
  1498. *   position of the matching occurrence.
  1499. *
  1500. *   If the source string is not contained within the target
  1501. *   string, if the source string is longer than the target
  1502. *   string, or if the source string is null, 0 is returned.
  1503. *
  1504. * PARAMETER(S)
  1505. *   The first parameter is the string to find.  The second
  1506. *   parameter is the string to search in.  In theory, any
  1507. *   character expression should be legal.
  1508. *
  1509. * EXAMPLE(S)
  1510. *
  1511. *   ? _RAT("A","ABABA")                      && Returns 5
  1512. *   lc_var = _RAT("A test","A test A test")  && Returns 8
  1513. *   ? _RAT("Long string","short")            && Returns 0
  1514. *
  1515. *--------------------------------------------------------------------
  1516.  
  1517.    PRIVATE lc_len
  1518.  
  1519.    m->lc_len = LEN( m->pc_target )
  1520.  
  1521.    DO WHILE m->lc_len > 0
  1522.      IF m->pc_source $ SUBSTR(m->pc_target, m->lc_len)
  1523.        EXIT
  1524.      ELSE
  1525.        m->lc_len = (m->lc_len - 1)
  1526.      ENDIF
  1527.    ENDDO
  1528.  
  1529.    RETURN m->lc_len
  1530.  
  1531. *-- EOF: _Rat( pc_source, pc_target )
  1532.  
  1533. {    return;
  1534. enddef
  1535.  
  1536. //--------------------------------------------------------------
  1537. define make_help()
  1538. // Make the dBASE code for help
  1539. }
  1540. PROCEDURE Help
  1541. PARAMETER lc_var
  1542. *{replicate("-",69)}
  1543. * DESCRIPTION
  1544. *   Activates the HELP window
  1545. *{replicate("-",69)}
  1546. { lmarg(offset)}
  1547. PRIVATE ALL LIKE ??_*
  1548. ON KEY LABEL F1{tabto(41)}&& Dsiable the F1 key during help
  1549. IF .NOT. FILE("{fileroot(hlp_name)}.dbf")
  1550.   *-- Help file has been deleted or can't be found
  1551.   DO _Err_Box WITH "{help_err1}" + "{fileroot(hlp_name)}.dbf"
  1552.   RETURN
  1553. ENDIF
  1554. ll_cat = SET( "CATALOG" ) = "ON"
  1555. SET CATALOG OFF
  1556.  
  1557. SET CURSOR OFF
  1558.  
  1559. *-- Select workarea and open Help dbf
  1560. lc_area = ALIAS()
  1561.  
  1562. *-- Open the HELP dbf file for the form
  1563. SELECT SELECT()
  1564. USE {fileroot(hlp_name)} ORDER fld_name NOUPDATE NOLOG
  1565.  
  1566. ll_exact = SET("EXACT") = "ON"
  1567. SET EXACT ON
  1568. SEEK lc_var{tabto(41)}&& Search for the field name in help
  1569. IF .NOT. ll_exact
  1570.   SET EXACT OFF
  1571. ENDIF
  1572. IF FOUND()
  1573.   *-- Define the coord for the help window
  1574.   ln_t = 5
  1575.   ln_l = 6
  1576.   ln_b = 15
  1577.   ln_r = 74
  1578.   ON KEY LABEL F3 DO Toggle
  1579.   DEFINE WINDOW z_help FROM ln_t+1, ln_l+2 TO ln_b-1, ln_r-2 NONE
  1580.   ON ERROR lc_error=error()
  1581.   SAVE SCREEN TO zz_help
  1582.  
  1583.   *-- Make Help Box
  1584.   DO shadowg WITH ln_t, ln_l, ln_b, ln_r
  1585.   @ ln_t+1, ln_l+1 CLEAR TO ln_b-1, ln_r-1
  1586.   @ ln_t, ln_l TO ln_b, ln_r DOUBLE
  1587.  
  1588.   ln_memline = SET("MEMO")
  1589.   SET MEMOWIDTH TO 65
  1590.   IF MEMLINES(fld_help) > 9
  1591.     @ ln_t+1,ln_r SAY CHR(24)
  1592.     @ ln_b-1,ln_r SAY CHR(25)
  1593.   ENDIF
  1594.   lc_string = CHR(185)+ [ Help for ] + TRIM(fld_headng) +[ ] + CHR(204)
  1595.   lc_message = IIF(MEMLINES(fld_help) > 9, ;
  1596.                   "{help_msg1 + help_msg2}", ;
  1597.                   "{help_msg2}" ;
  1598.                   )
  1599.  
  1600.   @ ln_t,CENTER(lc_string,80) SAY lc_string
  1601.   @ 0,0 GET fld_help OPEN WINDOW z_help MESSAGE lc_message
  1602.   READ
  1603.   SET MEMOWIDTH TO ln_memline
  1604.   ON ERROR
  1605.   ON KEY LABEL F3
  1606.   RELEASE WINDOW z_help
  1607.   RESTORE SCREEN FROM zz_help
  1608.   RELEASE SCREEN zz_help
  1609. ELSE
  1610.   DO _Err_Box WITH [{help_err2} ] + lc_var
  1611. ENDIF
  1612. SET MESSAGE TO
  1613. IF ll_cat
  1614.   SET CATALOG ON
  1615. ENDIF
  1616. SET CURSOR ON
  1617. USE{tabto(41)}&& Close help file
  1618. SELECT (lc_area){tabto(41)}&& Back to edit work area
  1619. ON KEY LABEL F1 DO Help WITH VARREAD()
  1620. {    lmarg(0)}
  1621. RETURN
  1622. *-- EOP: HELP
  1623.  
  1624.  
  1625. PROCEDURE Toggle
  1626. *{replicate("-",69)}
  1627. * DESCRIPTION
  1628. *   Toggles the Help message back to the original screen
  1629. *{replicate("-",69)}
  1630. {    lmarg(offset)}
  1631. PRIVATE ll_cons
  1632. SAVE SCREEN to Toggle
  1633. RESTORE SCREEN FROM zz_help
  1634. SET MESSAGE TO "Press any key..."
  1635. ll_cons = SET( "CONSOLE" ) = "ON"
  1636. SET CONSOLE OFF
  1637. WAIT
  1638. IF ll_cons
  1639.   SET CONSOLE ON
  1640. ENDIF
  1641. RESTORE SCREEN FROM Toggle
  1642. RELEASE SCREEN Toggle
  1643. SET MESSAGE TO "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Ctrl-End   See Org. Screen: F3"
  1644. {    lmarg(0)}
  1645. RETURN
  1646. *-- EOP: Toggle
  1647.  
  1648.  
  1649. FUNCTION Center
  1650. PARAMETER lc_string, ln_width
  1651. *{replicate("-",69)}
  1652. * NAME
  1653. *   Center() - Provide column needed to center a string in a width
  1654. *
  1655. * DESCRIPTION 
  1656. *   The CENTER() function will return the starting column 
  1657. *   coordinate to center the <lc_string> string within a width of 
  1658. *   screen <ln_width>.  The width of the screen would normally be 
  1659. *   80 colunms, but could just as well be the width of a window.  
  1660. *   If there is an error condition, the returned result will equal 0.
  1661. *   If a numeric value is passed for the <expC> value, it will be 
  1662. *   converted to a string.
  1663. * 
  1664. * EXAMPLES
  1665. * 
  1666. *   @ 15,center(string,80) say string    
  1667. * 
  1668. *   Will center the <string> withing 80 columns
  1669. * 
  1670. *-----------------------------------------------------------------------------
  1671.   PRIVATE lc_result, lc_type
  1672.  
  1673.   IF .NOT. TYPE("ln_width") $ "FN"{tabto(41)}&& Force value to 0 for bad type
  1674.     lc_result = 0
  1675.   ELSE
  1676.  
  1677.     lc_type = TYPE("lc_string")
  1678.     DO CASE
  1679.       CASE lc_type = "C"
  1680.         lc_width = (ln_width/2)-(LEN(lc_string)/2)
  1681.       CASE lc_type $ "NF"
  1682.         lc_width = (ln_width/2)-(LEN(ALLTRIM(STR(lc_string)))/2)
  1683.       CASE lc_type = "L"
  1684.         lc_width = (ln_width/2)-(1.5){tabto(41)}&& .T. or .F. have fixed len of 3
  1685.       OTHERWISE                          
  1686.         lc_width = 0
  1687.     ENDCASE
  1688.   ENDIF
  1689.   
  1690.   IF lc_width < 0{tabto(41)}&& Force negative values to 0
  1691.     lc_width = 0
  1692.   ENDIF
  1693.  
  1694. RETURN ( lc_width )
  1695. *-- EOF: Center( lc_string, ln_width )
  1696.  
  1697. {return;
  1698. enddef
  1699.  
  1700. define output_set_proc_code()
  1701. }
  1702. *-- Set procedure to the lookup programs
  1703. ll_echo = SET( "ECHO" ) = "ON"
  1704. SET ECHO OFF
  1705.  
  1706. lc_proc = SET("procedure"){tabto(41)}&& Store procedure file name
  1707. IF FILE("{cap_first(udf_filename)}.prg") .OR. FILE("{cap_first(udf_filename)}.dbo")
  1708.   SET PROCEDURE TO {cap_first(udf_filename)}
  1709. ELSE
  1710.   lc_fullpath = SET("FULLPATH")
  1711.   SET FULLPATH ON
  1712.   lc_setfmt = SET("FORMAT")
  1713.  
  1714.   *-- Pull out the file path from the format file for a prefix
  1715.     lc_slash = IIF( LEFT( OS(), 3 ) = "DOS", "\", "/" )
  1716.  
  1717.     *-- Look for last slash in the string
  1718.     m->lc_len = LEN( lc_setfmt )
  1719.     DO WHILE m->lc_len > 0
  1720.       IF m->lc_slash $ SUBSTR(m->lc_setfmt, m->lc_len)
  1721.         EXIT
  1722.       ELSE
  1723.         m->lc_len = m->lc_len - 1
  1724.       ENDIF
  1725.     ENDDO
  1726.  
  1727.   lc_fullnam = LEFT( lc_setfmt, m->lc_len ) + "{cap_first(udf_filename)}"
  1728.   IF FILE( lc_fullnam + ".prg" ) .OR. FILE( lc_fullnam + ".dbo" )
  1729.     SET PROCEDURE TO ( lc_fullnam )
  1730.   ELSE
  1731.  
  1732.     *-- Display the error message in a windowed box
  1733.     PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,;
  1734.             ll_escape
  1735.  
  1736.     lc_anykey = [Press any key to continue...]
  1737.     ln_press  = LEN( lc_anykey )
  1738.     lc_msg = "{proc_err} {cap_first(udf_filename)} {file_err}"
  1739.     ln_msglen = LEN( lc_msg )
  1740.     ln_width = 0
  1741.     ll_escape = SET("ESCAPE") = "ON"
  1742.     SET ESCAPE OFF
  1743.  
  1744.     *-- Determine the width needed for the window:
  1745.     IF ln_msglen <= ln_press
  1746.       ln_width = ln_press
  1747.     ELSE
  1748.       *-- Make sure the message fits in the window:
  1749.       IF ln_msglen > 76
  1750.         lc_msg = LEFT( lc_msg, 76 )
  1751.         ln_msglen = 76
  1752.       ENDIF
  1753.       ln_width = ln_msglen
  1754.     ENDIF
  1755.     DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ;
  1756.                   TO 15, (ln_width + 83) / 2 DOUBLE
  1757.     ln_width = ( ln_width + 2 )
  1758.  
  1759.     *-- Display the message and prompt to the window and wait for a key press
  1760.     ACTIVATE WINDOW _err_box
  1761.     ? lc_msg AT ( ln_width - ln_msglen ) / 2 
  1762.     ?
  1763.     ? lc_anykey AT ( ln_width - ln_press ) / 2 
  1764.     SET CONSOLE OFF
  1765.     WAIT
  1766.     SET CONSOLE ON
  1767.  
  1768.     *-- Clean up the window display and reactivate the previous window
  1769.     RELEASE WINDOW _err_box
  1770.  
  1771.     IF ll_escape
  1772.       SET ESCAPE ON
  1773.     ELSE
  1774.       SET ESCAPE OFF
  1775.     ENDIF
  1776.  
  1777.   ENDIF
  1778.  
  1779.   IF lc_fullpath = "OFF"
  1780.     SET FULLPATH OFF
  1781.   ENDIF
  1782.  
  1783. ENDIF{tabto(41)}&&   UDF's won't run
  1784.  
  1785. {
  1786. return;
  1787. enddef
  1788.  
  1789. include "cm_udf.cod"  // Template language UDFs
  1790. // EOP FORM.COD
  1791. }
  1792. 
  1793.